Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/pattern2.pas

Pascal/Delphi Source File | 1994-07-25 | 2KB | 160 lines

program assemblergogo;
{
    Patterns
    - by Bjarke Viksφe
    feb 1994

  THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.

    Second version of my first program ever on PC :->
    A bit faster I think!
    Can now do DPMI
}


const
    width = 320;

var
    oldmode, oldpage : shortint;
    i, j             : integer;
    ytaller          : integer;
    xtabel           : array [0..319] of integer;
    ytabel           : array [0..255] of integer;


(*-----------------------------------------------------------*)

procedure VBLANK;
begin
      asm
      mov     dx,$3DA
@vent1:
      in      al,dx
      test    al,8
      jz      @vent1
@vent2:
      in      al,dx
      test    al,8
      jnz     @vent2
      end;
end;


(*-----------------------------------------------------------*)

procedure SetColor(nr : integer; r,g,b : byte);
begin
      asm
      mov    bx,nr
      mov    cl,r
      mov    ch,g
     mov    dh,b
     mov    ax,$1010
      int    $10
      end;
end;

procedure OpenScreen;
var
    i, color : integer;
begin
    asm
    mov     ah,$0F
    int     $10
    mov     oldmode,al

    mov     al,$13
    xor     ah,ah
    int     $10
    end;

    color := 0;
    for i:=1 to 63 do begin
        SetColor(i, color,color,color);
        inc(color);
    end;
    for i:=64 to 127 do begin
        SetColor(i, color,color,color);
        dec(color);
    end;
end;

procedure CloseScreen;
begin
     asm
     mov    al,oldmode
      xor    ah,ah
      int    $10
      end;
end;


(*-----------------------------------------------------------*)

procedure SetupDemo;
begin
    for i:=0 to 319 do xtabel[i]:=sqr(i-160);
    for i:=0 to 199 do ytabel[i]:=sqr(i-100);
end;

(*-----------------------------------------------------------*)

procedure MakePattern(value : byte);
begin
    ytaller := 200;
    asm
    mov     ax,SEGA000
    mov     es,ax
    mov     di,0

    lea    bx,ytabel
    mov    cl,value
    mov    ch,127
    cld
@yloop:
    mov    dl,160
    lea    si,xtabel
@xloop1:
    lodsw
    add    ax,[bx]
    shr    ax,cl
    and    al,ch
    mov    dh,al

    lodsw
    add    ax,[bx]
    shr    ax,cl
    and    al,ch
    mov    ah,al
    mov    al,dh
    stosw
    dec    dl
    jnz    @xloop1

    add    bx,2
    dec    ytaller
    jnz    @yloop
    end;
end;



begin
    SetupDemo;
    OpenScreen;
    for j:=1 to 4 do begin
        for i:=0 to 16 do begin
            VBLANK;
            MakePattern(i);
        end;
        for i:=15 downto 1 do begin
            VBLANK;
            MakePattern(i);
        end;
    end;
    CloseScreen;
end.